home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #11 / Amiga Plus CD - 2004 - No. 11.iso / AmiSoft / Misc / emu / p-interp.lha / p-interp-0.5 / arexxturtleserver.e < prev    next >
Text File  |  2002-05-08  |  3KB  |  97 lines
  1. /*
  2.  
  3.   Turtlegraphics server (to use the apple pascal unit)
  4.   Copyright © 2001/02 Stefan Haubenthal
  5.  
  6.   This program is free software; you can redistribute it and/or modify
  7.   it under the terms of the GNU General Public License as published by
  8.   the Free Software Foundation; either version 2 of the License, or
  9.   (at your option) any later version.
  10.  
  11.   This program is distributed in the hope that it will be useful,
  12.   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.   GNU General Public License for more details.
  15.  
  16.   You should have received a copy of the GNU General Public License
  17.   along with this program; if not, write to the Free Software
  18.   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19.  
  20. */
  21.  
  22. MODULE 'tools/arexx'
  23.  
  24. CONST XSIZE=280
  25. CONST YSIZE=192
  26.  
  27. DEF currentViewPort
  28. DEF currentPenColor
  29. DEF currentTurtleX
  30. DEF currentTurtleY
  31. DEF currentTurtleAng
  32. DEF currentCharType
  33.  
  34. DEF wptr
  35.  
  36. PROC main()
  37.   rx_HandleAll({turtleCommandHandler},'TURTLESERVER')
  38.   IF wptr THEN CloseW(wptr)
  39. ENDPROC
  40.  
  41. PROC turtleCommandHandler(buffer)
  42.   WriteF('Received message "\s" from ARexx!\n',buffer)
  43.   IF CtrlC() THEN RETURN
  44.   IF StrCmp(buffer, 'INITTURTLE') THEN initTurtle(0,0)
  45.   IF StrCmp(buffer, 'TURN') THEN turnTo(0)
  46.   IF StrCmp(buffer, 'TURNTO') THEN turnTo(0)
  47.   IF StrCmp(buffer, 'MOVE') THEN moveTo(0,0)
  48.   IF StrCmp(buffer, 'MOVETO') THEN moveTo(0,0)
  49.   IF StrCmp(buffer, 'PENCOLOR') THEN currentPenColor:=NIL
  50.   IF StrCmp(buffer, 'TEXTMODE') THEN NIL
  51.   IF StrCmp(buffer, 'GRAFMODE') THEN NIL
  52.   IF StrCmp(buffer, 'FILLSCREEN') THEN fillScreen(0)
  53.   IF StrCmp(buffer, 'VIEWPORT') THEN currentViewPort:=NIL
  54.   IF StrCmp(buffer, 'TURTLEX') THEN currentTurtleX:=NIL
  55.   IF StrCmp(buffer, 'TURTLEY') THEN currentTurtleY:=NIL
  56.   IF StrCmp(buffer, 'TURTLEANG') THEN currentTurtleAng:=NIL
  57.   IF StrCmp(buffer, 'SCREENBIT') THEN NIL
  58.   IF StrCmp(buffer, 'DRAWBLOCK') THEN drawByte(0,0,0,0,0,0)
  59.   IF StrCmp(buffer, 'WCHAR') THEN wChar(0)
  60.   IF StrCmp(buffer, 'WSTRING') THEN NIL
  61.   IF StrCmp(buffer, 'CHARTYPE') THEN currentCharType:=NIL
  62. ENDPROC StrCmp(UpperStr(buffer),'QUIT'),0,'result!'
  63.  
  64. PROC initTurtle(width,height)
  65.   VOID width
  66.   VOID height
  67.   IF wptr=0 THEN wptr:=OpenW(20,50,XSIZE,YSIZE,0,0,'ARexxTurtlegraphicsServer',NIL,1,0)
  68. ENDPROC
  69.  
  70. PROC turnTo(angle)
  71. currentTurtleAng:=angle
  72. ENDPROC
  73.  
  74. PROC moveTo(x,y)
  75. Plot(x, y, currentPenColor)
  76. ENDPROC
  77.  
  78. PROC fillScreen(color)
  79. Colour(color)
  80. ENDPROC
  81.  
  82. PROC wChar(ch)
  83. TextF(currentTurtleX, currentTurtleY, ch)
  84. ENDPROC
  85.  
  86. PROC drawByte(data,xSkip,width,xScreen,yScreen,mode)
  87. xSkip
  88. width
  89. mode
  90. VOID {systemCharset}
  91. TextF(xScreen, yScreen, data)
  92. ENDPROC
  93.  
  94. systemCharset: INCBIN 'system.charset'
  95.  
  96. VOID '$VER: arexxturtleserver 0.2 $'
  97.